{***************************************************************
    SpyGestion  Copyright (C) 2008 Christophe KOALI <nature2gas@gmail.com>
    
    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.
    
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.
    
    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
    
****************************************************************}
unit modParsingClassIRessource;

interface

uses modParsingClassBase,
     modBaseType,
     Classes,
     sFonctionsChaines,
     SysUtils,
     Windows,

     modClassRessources,

     LibXmlParser;


type


    TParsingRessource = class(IParsingRedirection)
    private
       //
       // Informations qui vont être extraites
       //

       // Liste des éléments du tableau
       FRessourcesList : TListRessources;

       // Adresse du formulaire si l'on veut modifier les données
       // La méthode est normalement "post"
       FFormAction: string;

       // pour le bouton valider:
       // car les données postées ressemble à:
       // last1=100&last2=100&last3=100&last4=100&last12=100&action=Calculer
       // quand on met tout à 100%
       FSubmitPostAdd: string;







       //
       // Variables qui vont aider à se repérer dans la page
       //

       FInForm: boolean;
       FInTable: boolean;
       FCurrTableLigne: integer;

       FCurrTableColone: integer;
       FInSelect: boolean;
       FItemsTerminated: boolean;


       //
       // Variables qui vont aider à l'extraction des données
       //


       FCurrElement: POGResUsed;





       procedure InitPointeur;

    public
       //
       // Informations ont été extraites
       //

       property RessourcesList   : TListRessources read FRessourcesList;
       property FormAction       : string          read FFormAction;
       property SubmitPostAdd    : string          read FSubmitPostAdd;




       /////////////////////////////////////////////////////////////////////////
       // Implémentation de IParsingRedirection

        // initialise l'interface
        procedure Initialisation; override;

        // obtient le résultat d'analyse
        function  GetFinalState: TParsingResultState; override;

        procedure SetFullURLFromBase(const BaseLink: string); override;


        procedure ScanOnStartTag(Sender: TObject; TagName: string; Attributes: TAttrList); override;
        procedure ScanOnEndTag(Sender: TObject; TagName: string); override;
        procedure ScanOnContent(Sender: TObject; Content: string); override;

       //
       /////////////////////////////////////////////////////////////////////////


       constructor Create;
       destructor Destroy; override;
    end;


implementation

uses modLanguageParsing, modCore, sHTMLFonctions;


function TParsingRessource.GetFinalState: TParsingResultState;
begin
    Result := PRESULT_ECHEC;

    if FError then begin
       exit;
    end;

    if FRessourcesList.Count < 1 then begin
       // il y a toujours le revenu de base
       exit;
    end;


    {$IFDEF DEBUG_PARSING}
         FRessourcesList.DebugProc := FDebugProcParsing;
         FRessourcesList.SendToDebugAllInfo;
    {$ENDIF}

    

    Result := NoT(PRESULT_ECHEC);
end;

procedure TParsingRessource.Initialisation;
begin
       inherited;
       
       //
       // Informations qui vont être extraites
       //

       FRessourcesList.ClearAndFree;
       FSubmitPostAdd := '';
       FFormAction    := '';

       //
       // Variables qui vont aider à se repérer dans la page
       //

       FInForm           := false;
       FInTable          := false;

       FCurrTableLigne   := 0;
       FCurrTableColone  := 0;

       FInSelect := false;
       FItemsTerminated := false;


       //
       // Variables qui vont aider à l'extraction des données
       //

       FCurrElement := nil;
end;



procedure TParsingRessource.SetFullURLFromBase(const BaseLink: string);
begin
    inherited;
    
    // Définit l'url entière du formulaire
    FFormAction  := sHTML_Get_URL_Lien(BaseLink, FFormAction);
end;

procedure TParsingRessource.InitPointeur;
begin
    FCurrElement.Activite      := -1;
    FCurrElement.prEnergie     := 0;
    FCurrElement.csEnergieUsed := 0;
    FCurrElement.csEnergieAllow := 0;
    FCurrElement.prMetal     := 0;
    FCurrElement.prCristal   := 10;
    FCurrElement.prDeuterium := 0;
    FCurrElement.IdOpt       := '';
    FCurrElement.ActiviteForOptimization := -1;

    FCurrElement.Element    := '';
    FCurrElement.ElementGID := -1;
    FCurrElement.ElementLVL := -1;
end;




procedure TParsingRessource.ScanOnStartTag(Sender: TObject; TagName: string; Attributes: TAttrList);
var CurrAttrib: string;
    aName : string;
begin

   TagName := lowercase(TagName);

   if TagName = 'form' then begin
      // <form action="resources.php?session=000000000" method="post">
      FInForm := true;
      FFormAction := Attributes.Value('action');
      exit;
   end;

   if FInForm = false then exit;

   if TagName = 'table' then begin
      FInTable := true;
      FCurrTableLigne := 0;
      exit;
   end;

   if FInTable = false then exit;

   if TagName = 'tr' then begin
      Inc(FCurrTableLigne);
      FCurrTableColone := 0;
   end else if (TagName = 'th') or (TagName = 'td') then begin
      Inc(FCurrTableColone);

   end else if TagName = 'select' then begin
      FInSelect := true;
      if FCurrElement <> nil then
         FCurrElement.IdOpt       := Attributes.Value('name')
      else
         FError := true;




   end else if TagName = 'option' then begin
      // <option value="100" selected>
      // MAIS un pré traitement le transforme en:
      // <option value="100" selected="1">
      // Pour qu'il soit identifié par le parseur
      CurrAttrib := Attributes.Value('selected');

      if CurrAttrib = '1' then begin
         CurrAttrib := Attributes.Value('value');
         CurrAttrib := trim(CurrAttrib);

         if FCurrElement <> nil then
            FCurrElement.Activite := StrToIntDef(CurrAttrib, 50)
         else
            FError := true;

      end;

   end else if TagName = 'input' then begin
      // <input type=submit name=action value="Calculer">
      // last1=100&last2=100&last3=100&last4=100&last12=100&action=Calculer

      CurrAttrib := Attributes.Value('type');
      CurrAttrib := lowercase(CurrAttrib);

      if CurrAttrib = 'submit' then begin
         if FSubmitPostAdd <> '' then
            FSubmitPostAdd := FSubmitPostAdd + '&';
            
         FSubmitPostAdd := FSubmitPostAdd + Attributes.Value('name');
         CurrAttrib := Attributes.Value('value');
         FSubmitPostAdd := FSubmitPostAdd + '=' + CurrAttrib;
      end;

   end;



end;

procedure TParsingRessource.ScanOnEndTag(Sender: TObject; TagName: string);
begin
    // ATTENTION: 
    // Les </TH> ne sont pas obligatoires.
    if FInForm = false then exit;

    TagName := lowercase(TagName);

    if TagName = 'select' then begin
       FInSelect := false;

    end else if TagName = 'table' then begin
       //FScanner.StopParser := true;

       if FCurrElement <> nil then begin
          // Ajoute le dernier élément
          FRessourcesList.Add(FCurrElement);
          FCurrElement := nil;
       end;


    end else if TagName = 'form' then begin

       if FItemsTerminated then begin
          // Fin des éléments à scanner

       end; 

    end;

end;

procedure TParsingRessource.ScanOnContent(Sender: TObject; Content: string);
var xPos: integer;
    sTmp: string;
begin
    if FInTable = false then exit;
    if FInSelect then exit;
    if FItemsTerminated then begin
       exit;
    end;

    // La troisième ligne correspond au revenu de base
    if FCurrTableLigne < 3 then exit;

    Content := trim(Content);
    if Content = '' then exit;
    Content := lowercase(Content);



    case FCurrTableColone of
        1: begin
               // Nom du batiment, et son niveau


               if pos(LangParsing.GetData('ressource_strlw_capici', 'capacit'), Content) > 0 then begin
                  // Fin des éléments à scanner
                  //FScanner.StopParser := true;
                  FItemsTerminated := true;


                  // Ajoute le dernier élément
                  FRessourcesList.Add(FCurrElement);
                  FCurrElement := nil;

                  
               end else if pos('(', Content) > 0 then begin
                  if FCurrElement <> nil then begin
                     FCurrElement.Element := Content;
                  end;
               end;


           end;

        2: begin
             if SameText(Content, '&nbsp;') then begin
                // dans la nouvelle version (0.76 du 26 février 2007)
                // ils ont ajouté une colonne 'invisible'...
                Dec(FCurrTableColone);
                exit;
             end;

             if FCurrElement = nil then
                New(FCurrElement)
             else begin
                FRessourcesList.Add(FCurrElement);
                New(FCurrElement);
             end;
             InitPointeur;

             Content := sfcRemplace(Content, '.', '');
             FCurrElement.prMetal     := StrToIntDef(Content, 0);
           end;

        3: if FCurrElement = nil then begin
              // Fatal error
              SysUtils.Beep;
              FError := true;
           end else begin
              Content := sfcRemplace(Content, '.', '');
              FCurrElement.prCristal   := StrToIntDef(Content, 0);
           end;

        4: if FCurrElement = nil then begin
              // Fatal error
              SysUtils.Beep;
              FError := true;
           end else begin
              Content := sfcRemplace(Content, '.', '');
              FCurrElement.prDeuterium := StrToIntDef(Content, 0);
           end;

        5: begin
             // Soit une valeur entière, soit
             // une valeur avec fraction: 1125/1162
             Content := sfcRemplace(Content, '.', '');
             
             xPos := pos('/', Content);

             if FCurrElement = nil then begin
                SysUtils.Beep;
                FError := true;
                exit;
             end;

             if xPos = 0 then begin
                 // energie produite
                 FCurrElement.prEnergie := StrToIntDef(Content, 0);

             end else begin
                 sTmp := copy(Content, 1, xPos - 1);
                 System.Delete(Content, 1, xPos);

                 FCurrElement.csEnergieUsed  := StrToIntDef(sTmp, 0);
                 FCurrElement.csEnergieAllow := StrToIntDef(Content, 0);

             end;

          end;
        6: begin
               // select, on ignore

           end;
    end;


end;



constructor TParsingRessource.Create;
begin
    inherited;

    FRessourcesList     := TListRessources.Create;

    FCurrElement := nil;
end;

destructor TParsingRessource.Destroy;
begin
    FRessourcesList.ClearAndFree;
    FRessourcesList.Free;

    inherited;
end;



end.
